home *** CD-ROM | disk | FTP | other *** search
/ Risc World 3 / Risc World 3.iso / SOFTWARE / ISSUE4 / POWERBASE / LABEL / !PrintLbls / !RunImage (.txt) < prev    next >
RISC OS BBC BASIC V Source  |  2000-03-04  |  32KB  |  1,332 lines
  1.  ><PrintLbls$Dir>.!RunImage
  2.  !PrintLbls:
  3.  Steven Haslam 1991-5
  4.  Sliding heap manager:
  5.  Steven Haslam 1992
  6.  Improved font handling by Harriet Bazley 1999
  7.  Dialogue boxes altered by Derek Haslam, Dec 1999
  8.  TASK 4:$TASK="TASK"
  9.  wimpmessages 32
  10. !wimpmessages=1
  11. wimpmessages!4=3
  12. wimpmessages!8=7
  13. wimpmessages!12=&400C0
  14. wimpmessages!16=&400C7
  15. wimpmessages!20=&80147
  16. wimpmessages!24=&400C1
  17. wimpmessages!32=0
  18.  "Wimp_Initialise",310,!TASK,"Label printer",wimpmessages 
  19.  version%,thistask%
  20. wimpy_error(
  21.  block% &400
  22. init_vars
  23. setup_heap
  24. load_setup
  25. i_size%=&1000
  26.  indirection% i_size%
  27. i_ptr%=indirection%
  28. i_end%=indirection%+i_size%
  29. menublocksize%=&200
  30.  menublock% menublocksize%
  31.  "OS_File",5,"<PrintLbls$Dir>.Sprites22" 
  32.  ,,,,splen%
  33. create_named_sliding_block(spritesanchor%,splen%+4)
  34. '#privatesprites%=!spritesanchor%
  35. !privatesprites%=splen%+4
  36.  "OS_ReadModeVariable",-1,4 
  37.  ,,x%
  38.  "OS_ReadModeVariable",-1,5 
  39.  ,,y%
  40.  x%=1 
  41.  y%=1 
  42.  f$="Sprites22" 
  43.  f$="Sprites"
  44.  "OS_File",255,"<PrintLbls$Dir>."+f$,privatesprites%+4
  45. load_windows
  46. mi_ptr%=i_ptr%
  47. create_menus
  48. create_iconbar
  49. quit%=
  50. erwok%=
  51. wimpy_error(
  52.  "Wimp_Poll",1,block% 
  53.  Reason%
  54.  Reason% 
  55.  1     : 
  56. redraww(!block%)
  57.  2     : 
  58.  "Wimp_OpenWindow",,block%
  59.  3     : 
  60. close_window(!block%)
  61.  6     : 
  62. mouse(block%!0,block%!4,block%!8,block%!12,block%!16)
  63.  8     : 
  64. keypress(block%!0,block%!4,block%!20,block%!24)
  65.  9     : 
  66. menu_choice
  67.  17,18 : 
  68. message_received
  69.  19    : 
  70. no_acknowledge
  71.  quit%
  72. shut_down
  73. shut_down
  74. lose_fonts
  75.  "Wimp_CloseDown"
  76. message_received
  77. fromtask%=block%!4
  78. my_ref%=block%!8
  79. your_ref%=block%!12
  80. message%=block%!16
  81.  OSCLI("Set Message$Type "+STR$~message%)
  82.  message% 
  83.  0: quit%=
  84.  Message_DataSave
  85.  (block%!40=&FFF 
  86.  block%!40=&DFE) 
  87.  ((block%!20=window%(mainW%,1) 
  88.  block%!24=3) 
  89.  (block%!20=-2 
  90.  block%!24=iconbarI%)) 
  91.    bar_drag%=block%!20=-2
  92.    block%!36=-1
  93.    block%!0=256
  94. W%   $(block%+44)="<Wimp$Scrap>"+
  95.    block%!12=my_ref%
  96.    block%!16=2
  97.  i%=0 
  98.  256 
  99. [!    block%!(i%+512)=block%!i%
  100.    inputfile$="
  101.  None 
  102.  block%!36=-1 
  103.     RAMb%=256
  104.     RAMb%=block%!36
  105.    transfers%=0
  106.    block%!36=RAMb%
  107.    filesize%=0
  108. f9   
  109.  !fileanchor% 
  110. scrap_sliding_block(fileanchor%)
  111. g9   
  112. create_named_sliding_block(fileanchor%,block%!36)
  113.    block%!16=6
  114.    block%!20=!fileanchor%
  115.    block%!24=block%!36
  116. k0   
  117.  "Wimp_SendMessage",18,block%,fromtask%
  118.  Message_DataLoad
  119.  (block%!40=&FFF 
  120.  block%!40=&DFE) 
  121.  ((block%!20=window%(mainW%,1) 
  122.  block%!24=3) 
  123.  (block%!20=-2 
  124.  block%!24=iconbarI%)) 
  125.    bar_drag%=(block%!20=-2)
  126. p#   
  127. loadCSV(
  128. getstr(block%+44))
  129.    block%!0=256
  130.    block%!12=my_ref%
  131.    block%!16=4
  132. t0   
  133.  "Wimp_SendMessage",17,block%,fromtask%
  134. u@   
  135.  apptrans% 
  136. ("Remove "+
  137. getstr(block%+44)):apptrans%=
  138.  Message_RAMTransmit
  139. RAMTransmit
  140.  &400C1: 
  141.  Message_ModeChange
  142. checkfontsOK
  143.  &400C0: 
  144.  Message_MenuWarning
  145.  block%!20<=windows% 
  146.    W%=block%!20
  147.  window%(W%,1)=-1 
  148. =    
  149.  "Wimp_CreateWindow",,window%(W%,2) 
  150.  window%(W%,1)
  151.    block%!20=window%(W%,1)
  152.  block%!20=fontM% 
  153. FontMenu(font$(1+block%!36)):$fontM%=menutitle$(1+block%!36)
  154.  "Wimp_CreateSubMenu",,block%!20,block%!24,block%!28
  155.  &400C7: 
  156.  Message_TaskNameIs
  157. 0  inputfile$="Data from "+
  158. getstr(block%+28)
  159.  bar_drag% 
  160. ask_if_print
  161. 5   $
  162. icontextaddr(window%(mainW%,1),2)=inputfile$
  163.  inputfile$>=18 
  164. rj(window%(mainW%,1),2)
  165. redrawicon(window%(mainW%,1),2)
  166.  &80147: 
  167.  printer changed
  168.  window%(mainW%,1)>0 
  169. pdriver
  170.    mainH%=window%(mainW%,1)
  171. @   $
  172. icontextaddr(mainH%,13)=pdriver$:
  173. redrawicon(mainH%,13)
  174. @   $
  175. icontextaddr(mainH%,14)=pres$   :
  176. redrawicon(mainH%,14)
  177. lighticon(mainH%,9,pdriver%)
  178. wimpy_error(code%,mess$,canquit%)
  179.  what%,result%
  180. @%="g10.9"
  181. error_error(
  182.  "Hourglass_Smash"
  183.  code%>1 
  184.  mess$+="; code: "+
  185.  code%
  186. what%=1
  187. mess$,11)="Fatal error":what%=2
  188.  canquit%:mess$+="; (Cancel to quit, OK to continue)":what%+=2
  189. !block%=code%
  190. $(block%+4)=mess$+
  191.  "Wimp_ReportError",block%,what%,"Label printer" 
  192.  ,result%
  193.  result%=2 
  194. shut_down
  195. error_error(erl%,err$)
  196. $+" at line "+
  197. !block%=0
  198. k$(block%+4)="Error in error handler! <sob> : "+err$+" at line "+
  199.  erl%+" : trying to close down neatly"
  200.  "Wimp_ReportError",block%,2,"Label printer"
  201. shut_down
  202. create_iconbar
  203. block%!0=-1
  204. block%!4=0
  205. block%!8=0
  206. block%!12=68
  207. block%!16=68
  208. block%!20=&3002
  209. $(block%+24)="!PrintLbls"
  210.  "Wimp_CreateIcon",,block% 
  211.  iconbarI%
  212. - Menu procedures BEGIN
  213. tickr(a%,i1%,i2%,ix%)
  214.  i%,ia%
  215. ia%=a%+28+24*i1%
  216.  i%=i1% 
  217.  ix%=i% 
  218.  !ia%=!ia% 
  219.  !ia%=!ia% 
  220.  &FFFFFFFE
  221. ia%+=24
  222. sub(m$,m%)="|sub"+
  223. "000000000000"+
  224. (m%),12)+m$
  225. menuitem(text$)
  226.  menuflags%,iconflags%,submenu%,indlen%,valid%
  227.  menuptr%+24>menend% 
  228.  255,"No room for primary menu definitions"
  229. valid%=-1
  230.     ii%=
  231. indlen%=-1
  232. submenu%=-1
  233.  text$="" 
  234. menuflags%=8
  235. iconflags%=&07000021
  236. text$,1)="|"
  237. text$,2,3) 
  238.  "brk":
  239. menuflags%+=2
  240. text$=
  241. text$,5)
  242.  "sub":
  243. submenu%=
  244. text$,5,12))
  245. text$=
  246. text$,17)
  247.  "lit":
  248. *iconflags%+=(1<<22)*(1-
  249. text$,5,1)))
  250. text$=
  251. text$,6)
  252.  "tog":
  253. menuflags%+=
  254. text$,5,1))
  255. text$=
  256. text$,6)
  257.  "wri":
  258. text$,5,2) 
  259.  "sp":indlen%=255:valid%=-1
  260. menuflags%+=%100
  261. text$=
  262. text$,7)
  263. (text$)>menumax% menumax%=
  264. (text$)
  265. menuptr%!0=menuflags%
  266. menuptr%!4=submenu%
  267. menuptr%!8=iconflags%
  268. (text$)>11 indlen%=
  269. (text$)
  270.  indlen%<0 
  271. $(menuptr%+12)=text$
  272. (menuptr%!8=(menuptr%!8) 
  273.  %100000000
  274. menuptr%!12=i_ptr%
  275. menuptr%!16=valid%
  276. menuptr%!20=indlen%
  277.  i_ptr%+indlen%+1>i_end% 
  278.  255,"No room for MENU indirection"
  279. $i_ptr%=text$
  280. i_ptr%+=indlen%+1
  281. menuptr%+=24
  282. makemen($block%,menutitle$)
  283. makemen2(block%,menutitle$)
  284. makemen2(mendat%,menutitle$)
  285.  menumax%,wasptr%
  286. wasptr%=menuptr%
  287. menumax%=10
  288. menuptr%!20=40
  289. $menuptr%=menutitle$
  290. menuptr%?12=7
  291. menuptr%?13=2
  292. menuptr%?14=7
  293. menuptr%?15=0
  294. maxaddr%=menuptr%+16
  295. menuptr%!24=0
  296. menuptr%+=28
  297. i1%=i%+1
  298. item$=""
  299.  i%?mendat%<>
  300.  i%?mendat%>=32
  301. item$+=
  302. (i%?mendat%)
  303.     i%+=1
  304.  i%?mendat%=
  305. "," i%+=1
  306. menuitem(item$)
  307.  i%?mendat%<32
  308. %menuptr%!-24=(menuptr%!-24) 
  309. !maxaddr%=menumax%*16+32
  310. =wasptr%
  311. open_menu(m%,x%,y%)
  312. MenuBLK%=m%
  313. MenuX%=x%
  314. MenuY%=y%
  315.  "Wimp_CreateMenu",,m%,x%,y%
  316. - Menu procedures 
  317. create_menus
  318.  "Hourglass_On"
  319. menuptr%=menublock%
  320. /%menend%=menublock%+menublocksize%
  321. i_ptr%=mi_ptr%
  322. 1TIconM%=
  323. makemen(
  324. sub("Info",infoW%)+",Save setup,Quit","PrintLbls"):I_entries%=3
  325. 2shighfontM%=
  326. makemen(
  327. sub(menutitle$(1),55)+","+
  328. sub(menutitle$(2),55)+","+
  329. sub(menutitle$(3),55),"Fonts setup")
  330.  The '55's are dummy values which will be replaced by fontM%
  331.  once we know what it is (after PROCFontMenu)
  332. 5QunitsM%=
  333. makemen("Inches,Points,Millipoints,Centimetres,Millimetres","Units")
  334. 6/units%=
  335. "**|in|pt|mp|cm|mm","|"+units$)/3-1
  336. tickr(unitsM%,0,4,units%)
  337. 8^mainM%=
  338. makemen(
  339. sub("Fonts",highfontM%)+",Remove CSV,"+
  340. sub("Units",unitsM%),"PrintLbls")
  341. FontMenu("")
  342. checkfontsOK
  343.  "Hourglass_Off"
  344. mouse(x%,y%,b%,w%,i%)
  345.  -2: 
  346. iconbar_click(x%,y%,b%)
  347.  window%(mainW%,1): 
  348. main_click(x%,y%,b%,w%,i%)
  349.  window%(errorW%,1): 
  350. error_click(w%,i%)
  351.  window%(setupW%,1): 
  352. setup_click(b%,w%,i%)
  353. iconbar_click(x%,y%,b%)
  354. open_window(mainW%)
  355. open_menu(IconM%,x%-64,96+40*I_entries%)
  356. error_click(w%,i%)
  357.  0,0,1280,1024
  358.  i%=3 
  359. shut_down
  360. close_window(errorW%)
  361. erwok%=
  362. setup_click(b%,w%,i%)
  363.  setupH%
  364. setupH%=w%
  365. write_label_sizes
  366. close_window(setupW%)
  367. write_label_sizes
  368.  temp%
  369. d$temp%=
  370. icontextaddr(setupH%,4)
  371.  temp%=0 
  372. wimpy_error(0,"You must have at least 1 label across!",
  373.  no_across%=temp%
  374. f$temp%=
  375. icontextaddr(setupH%,5)
  376.  temp%=0 
  377. wimpy_error(0,"You must have at least 1 label down!",
  378.  no_down%=temp%
  379. h1topmargin=
  380. strtomp($
  381. icontextaddr(setupH%,9))
  382. i2leftmargin=
  383. strtomp($
  384. icontextaddr(setupH%,8))
  385. j-width=
  386. strtomp($
  387. icontextaddr(setupH%,6))
  388. k.height=
  389. strtomp($
  390. icontextaddr(setupH%,7))
  391. l4indentation=
  392. strtomp($
  393. icontextaddr(setupH%,12))
  394. menu_choice
  395.  adjust%
  396. choice0%=block%!0
  397. choice1%=block%!4
  398.  "Wimp_DecodeMenu",,MenuBLK%,block%,block%+&100,&100
  399. t choice$=
  400. getstr(block%+&100)
  401.  "Wimp_GetPointerInfo",,block%+&100
  402. adjust%=(block%!&108) 
  403.  MenuBLK% 
  404.  IconM%:
  405. icon_menu(choice0%)
  406.  mainM%:
  407. main_menu(choice$,choice0%,choice1%)
  408.  fontM%:
  409. "Font_DecodeMenu",0,fontM%,block%,block%+&100,255
  410.  $fontM% 
  411. |"    
  412.  menutitle$(1):choice1%=1
  413. }"    
  414.  menutitle$(2):choice1%=2
  415. ~"    
  416.  menutitle$(3):choice1%=3
  417. font_menu_choice(choice1%,
  418. getstr(block%+&100))
  419.  adjust% 
  420.  MenuBLK%=fontM% 
  421.  choice0%=0 
  422. FontMenu(font$(choice1%)):$fontM%=menutitle$(choice1%)
  423. open_menu(MenuBLK%,MenuX%,MenuY%)
  424. getstr(p%)
  425.     p$=""
  426.  ?p%>31
  427.     p%+=1
  428. icon_menu(choice%)
  429.  choice% 
  430.  2: quit%=
  431. save_setup
  432. load_windows
  433.  filename$
  434. windows%=4
  435.  window%(windows%,2)
  436. window%()=-1
  437. )infoW%=1:mainW%=2:errorW%=3:setupW%=4
  438. *filename$="<PrintLbls$Dir>.Templates3"
  439.  "Wimp_OpenTemplate",,filename$
  440.  space for window def. = 88 + 32 * no. of icons
  441.  proginfoS% 88+32*10
  442.  "Wimp_LoadTemplate",,proginfoS%,i_ptr%,i_end%,-1,"progInfo" 
  443.  ,,i_ptr%
  444.  window%(infoW%,2)=proginfoS%
  445.  mainS% 88+32*25
  446.  "Wimp_LoadTemplate",,mainS%,i_ptr%,i_end%,-1,"main" 
  447.  ,,i_ptr%
  448. window%(mainW%,2)=mainS%
  449. mainS%!64=privatesprites%
  450.  errorS% 88+32*6
  451.  "Wimp_LoadTemplate",,errorS%,i_ptr%,i_end%,-1,"error" 
  452.  ,,i_ptr%
  453. window%(errorW%,2)=errorS%
  454.  setupS% 88+32*17
  455.  "Wimp_LoadTemplate",,setupS%,i_ptr%,i_end%,-1,"setuplabels" 
  456.  ,,i_ptr%
  457. window%(setupW%,2)=setupS%
  458. setupS%!64=privatesprites%
  459.  "Wimp_CloseTemplate"
  460. close_window(index%)
  461.  loop%,handle%
  462.  index%<=windows% 
  463.  window%(index%,1)=-1 
  464. handle%=window%(index%,1)
  465. handle%=index%
  466. !block%=handle%
  467.  "Wimp_CloseWindow",,block%
  468.  loop%=1 
  469.  windows%
  470.  window%(loop%,1)=handle% 
  471. window_delete(loop%)
  472. !block%=handle%
  473.  "Wimp_DeleteWindow",,block%
  474. window%(loop%,1)=-1
  475. loop%=windows%
  476.  index%=mainW% 
  477. close_window(setupW%)
  478. open_window(index%)
  479.  handle%
  480.  index%<=windows% 
  481.  window%(index%,1)=-1 
  482.  "Wimp_CreateWindow",,window%(index%,2) 
  483.  window%(index%,1)
  484. window_create(index%)
  485. handle%=window%(index%,1)
  486. handle%=index%
  487. !block%=handle%
  488.  "Wimp_GetWindowState",,block%
  489. block%!28=-1
  490.  "Wimp_OpenWindow",,block%
  491. redraww(handle%)
  492.  index%
  493. index%=
  494. index(handle%,
  495. !block%=handle%
  496.  "Wimp_RedrawWindow",,block% 
  497.  more%
  498.  more%
  499.  index% 
  500.  "Wimp_GetRectangle",,block% 
  501.  more%
  502. index(handle%,error%)
  503.  index%,loop%
  504. index%=0
  505.  loop%=1 
  506.  windows%
  507.  window%(loop%,1)=handle% 
  508. index%=loop%
  509. loop%=windows%
  510.  index%=0 
  511.  error% 
  512.  255,"Window index not found"
  513. =index%
  514. window_create(index%)
  515.  f%,handle%
  516. handle%=window%(index%,1)
  517.  index% 
  518.  mainW%:
  519.  f%=1 
  520. get_font(f%)
  521. icontextaddr(handle%,2)=inputfile$
  522.  inputfile$="
  523.  None 
  524.  inputfile$<18 
  525. centre(handle%,2) 
  526. rj(handle%,2)
  527. pdriver
  528. icontextaddr(handle%,13)=pdriver$
  529. icontextaddr(handle%,14)=pres$
  530. @%="+g10.3"
  531. icontextaddr(handle%,17)=
  532.  namesize+"pt"
  533. icontextaddr(handle%,18)=
  534.  addrsize+"pt"
  535. lighticon(handle%,9,pdriver%)
  536. update_fontcontrols
  537.  setupW%:
  538. icontextaddr(handle%,9)=
  539. display(topmargin)
  540. icontextaddr(handle%,8)=
  541. display(leftmargin)
  542. icontextaddr(handle%,6)=
  543. display(width)
  544. icontextaddr(handle%,7)=
  545. display(height)
  546. icontextaddr(handle%,12)=
  547. display(indentation)
  548. icontextaddr(handle%,4)=
  549. (no_across%)
  550. icontextaddr(handle%,5)=
  551. (no_down%)
  552. window_delete(index%)
  553.  index% 
  554.  mainW%: 
  555. lose_fonts
  556. init_vars
  557. cmtoin=(1/2.540005)
  558. inputfile$="
  559.  None 
  560. erwok%=
  561.  font$(3),font%(3,1)
  562. maxaddrs%=100:maxlines%=20
  563.  addr$(maxaddrs%,maxlines%),last%(maxaddrs%)
  564. apptrans%=
  565. namesize=24
  566. addrsize=12
  567.  transform% 16,rectangle% 16,plotpos% 8,labelrect% 16
  568.  menutitle$(3)
  569. menutitle$(1)="Name"
  570. menutitle$(2)="Address"
  571. menutitle$(3)="Last line"
  572. icontextaddr(wi%,ic%)
  573. q%=block%+&100
  574. q%!0=wi%:q%!4=ic%
  575.  "Wimp_GetIconState",,q%
  576. =q%!28
  577. loadCSV(fname$)
  578.  "Hourglass_On"
  579.  inputfile$<>"
  580.  None 
  581. scrap_sliding_block(fileanchor%)
  582.  "OS_File",5,fname$ 
  583.  ,,,,CSVlength%
  584. create_named_sliding_block(fileanchor%,CSVlength%)
  585.  "OS_File",255,fname$,!fileanchor%
  586. inputfile$=fname$
  587.  window%(mainW%,1)>0 
  588. icontextaddr(window%(mainW%,1),2)=inputfile$
  589.  inputfile$>=18 
  590. rj(window%(mainW%,1),2)
  591.  bar_drag% 
  592. ask_if_print
  593. checknewfile(CSVlength%)
  594.  "Hourglass_Off"
  595. setup_heap
  596. initheaps(1024,8)
  597. D,spritesanchor%=
  598. create_anchor("Sprites")
  599. E+fileanchor%=
  600. create_anchor("File data")
  601. F)fontmenu%=
  602. create_anchor("Font menu")
  603. G,indir%=
  604. create_anchor("indirected data")
  605. redrawicon(w%,i%)
  606. q%=block%+&100
  607. !q%=w%
  608. q%!4=i%
  609. q%!8=0
  610. q%!12=0
  611.  "Wimp_SetIconState",,q%
  612. main_click(x%,y%,b%,w%,i%)
  613. WI         
  614.  22,23,24:
  615. FontMenu(font$(i%-21)):$fontM%=menutitle$(i%-21)
  616. XD                     
  617.  icons 6 to 8 correspond to indices 1 to 3
  618. Y$                     
  619.  in arrays
  620. Z4                     
  621. open_menu(fontM%,x%-64,y%)
  622. [*         
  623. open_menu(mainM%,x%-64,y%)
  624.        
  625. _l    
  626. wimpy_error(0,"Drag a CSV file, type Text (&FFF) or CSV (&DFE), onto this icon to load it.",
  627. `%    
  628.  inputfile$="
  629.  None 
  630. aR      
  631. wimpy_error(0,"You must have loaded in a file in order to print it!",
  632.       
  633. print
  634.       
  635. d"    
  636. open_window(setupW%)
  637. save_setup
  638. fD    
  639.  22,23,24:
  640. FontMenu(font$(i%-21)):$fontM%=menutitle$(i%-21)
  641. g1                  
  642. open_menu(fontM%,x%-64,y%)
  643. main_menu(choice$,choice0%,
  644.  choice1%)
  645.  dot%
  646. dot%=
  647. choice$,".")
  648. choice$=
  649. choice$,dot%+1)
  650. dot%=
  651. choice$,".")
  652. choice$=
  653. choice$,dot%+1)
  654.  choice0% 
  655.  block%!8>0 
  656. "Font_DecodeMenu",0,fontM%,block%+8,block%+&100,255
  657.   font menu is 2nd submenu so font selections start at block%+8
  658.   choice1%+=1
  659.  so that 'font$(choice1%)' points to right value when we return to PROCmenuchoice
  660. font_menu_choice(choice1%,
  661. getstr(block%+&100))
  662.  inputfile$<>"
  663.  None 
  664. scrap_sliding_block(fileanchor%):!fileanchor%=0
  665. inputfile$="
  666.  None 
  667. icontextaddr(window%(mainW%,1),2)=inputfile$
  668. centre(window%(mainW%,1),2)
  669.  choice1% 
  670.  0:units$="in"
  671.  1:units$="pt"
  672.  2:units$="mp"
  673.  3:units$="cm"
  674.  4:units$="mm"
  675. /units%=
  676. "**|in|pt|mp|cm|mm","|"+units$)/3-1
  677. tickr(unitsM%,0,4,units%)
  678. font_menu_choice(choice1%,font$)
  679. change_font(choice1%,
  680. decodefontmenu(font$))
  681. change_font(area%,font$)
  682. lose_font(area%)
  683. font$(area%)=font$
  684. get_font(area%)
  685. update_fontcontrols
  686. lose_fonts
  687.  x%,y%
  688.  x%=1 
  689.  y%=0 
  690.  font%(x%,y%) 
  691.  "Font_LoseFont",font%(x%,y%)
  692. font%(x%,y%)=0
  693. lose_font(f%)
  694.  y%=0 
  695.  font%(f%,y%) 
  696.  "Font_LoseFont",font%(f%,y%)
  697. font%(f%,y%)=0
  698. get_font(f%)
  699.  "Font_FindFont",,font$(f%),12*16,12*16 
  700.  font%(f%,0)
  701. save_setup
  702.  setup%
  703. read_font_sizes
  704. %setup%=
  705. ("<PrintLbls$Dir>.Setup")
  706.  f%=1 
  707. #setup%,font$(f%)
  708. @%=&90A
  709. #setup%,
  710.  namesize
  711. #setup%,
  712.  addrsize
  713. #setup%,
  714.  topmargin
  715. #setup%,
  716.  leftmargin
  717. #setup%,
  718.  width
  719. #setup%,
  720.  height
  721. #setup%,
  722.  indentation
  723. #setup%,
  724.  no_across%
  725. #setup%,
  726.  no_down%
  727. #setup%,units$
  728. #setup%
  729. load_setup
  730.  setup%
  731. %setup%=
  732. ("<PrintLbls$Dir>.Setup")
  733.  f%=1 
  734. font$(f%)=
  735. #setup%
  736. namesize=
  737. #setup%)
  738. addrsize=
  739. #setup%)
  740. topmargin=
  741. #setup%)
  742. leftmargin=
  743. #setup%)
  744. width=
  745. #setup%)
  746. height=
  747. #setup%)
  748. indentation=
  749. #setup%)
  750. no_across%=
  751. #setup%)
  752. no_down%=
  753. #setup%)
  754. units$=
  755. #setup%
  756. #setup%
  757. update_fontcontrols
  758.  handle%,f%
  759. handle%=window%(mainW%,1)
  760.  f%=1 
  761. icontextaddr(handle%,f%+5)=font$(f%)
  762. !block%=handle%
  763. block%!4=f%+5
  764. %block%!8=(1<<6)+(font%(f%,0)<<24)
  765. block%!12=(1<<6)+(255<<24)
  766.  "Wimp_SetIconState",,block%
  767. read_font_sizes
  768.  handle%
  769. handle%=window%(mainW%,1)
  770. *namesize=
  771. icontextaddr(handle%,17))
  772. *addrsize=
  773. icontextaddr(handle%,18))
  774. memfile(
  775.  pointer%)
  776. getstr(pointer%)
  777. pointer%+=
  778.  s$+1
  779. - Business part BEGINS
  780. print
  781.  Hcount%,Hfiddle%
  782.  bar_drag% 
  783. read_font_sizes
  784.  "Hourglass_On"
  785. fileptr%=!fileanchor%
  786. filebase%=!fileanchor%
  787. "strsppage%=no_across%*no_down%
  788. addr$()=""
  789.  fiddle some blank records to force printing to start in right place
  790. 4Hfiddle%=
  791. icontextaddr(window%(mainW%,1),20))
  792.  Hfiddle%>strsppage% 
  793. wimpy_error(0,"Can't start at label "+
  794. (Hfiddle%)+" - you only have "+
  795. (strsppage%)+" labels on each page!",
  796. =Hfiddle%-=1:
  797.  Humans start from 1 but arrays start from 0
  798.  Hfiddle%>0 
  799.  Hcount%=0 
  800.  Hfiddle%-1:addr$(Hcount%,0)="":last%(Hcount%)=0:
  801.  Then subtract another 1 since this is the number of the first label
  802.  NOT to be skipped!
  803. <labelN%=Hcount%:
  804.  will now be next number after Hfiddle%
  805.  (fileptr%-filebase%)<=CSVlength%
  806. ! line$=
  807. memfile(fileptr%)+","
  808.  line$<>"," 
  809.   line%=0
  810.  line$>""
  811. line$,1)="""" 
  812.     quote%=
  813. line$,
  814. 34,2)
  815. $    nextpart$=
  816. line$,2,quote%-2)
  817.     line$=
  818. line$,quote%+2)
  819.     comma%=
  820. line$,",")
  821. "    nextpart$=
  822. line$,comma%-1)
  823.     line$=
  824. line$,comma%+1)
  825. %   addr$(labelN%,line%)=nextpart$
  826.    line%+=1
  827.   last%(labelN%)=line%-1
  828.   labelN%+=1
  829.  labelN%=strsppage% 
  830. print_page
  831.   labelN%=0
  832.   addr$()=""
  833.  labelN%>0 
  834. print_page
  835.  "Hourglass_Off"
  836. show_addrs
  837.  i%=0 
  838.  labelN%-1
  839.  j%=0 
  840.  last%(i%)
  841.  addr$(i%,j%)
  842. printing_error(N%,e$)
  843. wimpy_error(N%,"1 """+e$+""" during printing",
  844.  "PDriver_AbortJob",file%
  845. #file%
  846. wimpy_error(N%,"2"""+e$+""" during printing",
  847. print_page
  848.  OStm,OSlm,OSwd,OSht
  849. ("RMEnsure PDriver Error 255 No PDriver module!")
  850.  "PDriver_Info" 
  851.  ,xres%,yres%,features%
  852.  "PDriver_PageSize" 
  853.  ,xsize%,ysize%
  854. file%=
  855. ("printer:")
  856. printing_error(
  857.  "PDriver_SelectJob",file%,inputfile$
  858.  For PostSciprt printers, declare fonts
  859.  features% 
  860.  (1<<29) 
  861. declarefont(font$(1))
  862. A4   
  863.  font$(2)<>font$(1) 
  864. declarefont(font$(2))
  865. BI   
  866.  font$(3)<>font$(2) 
  867.  font$(3)<>font$(1) 
  868. declarefont(font$(3))
  869.  "PDriver_DeclareFont"
  870. OSlm=leftmargin/72000*180
  871. OStm=topmargin/72000*180
  872. OSwd=width/72000*180
  873. OSht=height/72000*180
  874. transform%!00=
  875. fixed16(1)
  876. transform%!04=
  877. fixed16(0)
  878. transform%!08=
  879. fixed16(0)
  880. transform%!12=
  881. fixed16(1)
  882. top=ysize%/72000*180
  883. rectangle%!0=0
  884. rectangle%!4=0
  885. P!rectangle%!8=xsize%/72000*180
  886. rectangle%!12=top
  887. plotpos%!0=0
  888. plotpos%!4=0
  889.  "PDriver_GiveRectangle",1,rectangle%,transform%,plotpos%,-256
  890.  "PDriver_DrawPage",1,rectangle% 
  891.  more%,,rect%
  892.  more%
  893.  xn%=0:yn%=0
  894.  x=OSlm:y=top-OStm
  895.  l%=0 
  896.  labelN%
  897.   labelrect%!0=x
  898.   labelrect%!4=y-OSht
  899.   labelrect%!8=x+OSwd
  900.   labelrect%!12=y
  901. intersect(rectangle%,labelrect%) 
  902. printlabel(l%,x,y)
  903.   xn%+=1:x+=OSwd
  904.  xn%=no_across% 
  905.  yn%+=1:xn%=0:x=OSlm:y-=OSht
  906.  "PDriver_GetRectangle",,rectangle% 
  907.  more%,,rect%
  908.  "PDriver_EndJob",file%  
  909. "XOS_Find",0,file%
  910.  CLOSE#file%
  911. declarefont(font_name$)
  912.  "PDriver_DeclareFont",,font_name$
  913. printlabel(label%,x%,y%)
  914.  loop%,dy%
  915. dy%=namesize/72*180
  916. y%-=dy%
  917.  "Font_FindFont",,font$(1),namesize*16,namesize*16 
  918.  font%(1,1)
  919.  "Font_SetFont",font%(1,1)
  920.  "ColourTrans_SetFontColours",,-256,0,14
  921.  "Font_Paint",,addr$(label%,0),1<<4,x%,y%
  922.  "Font_LoseFont",font%(1,1)
  923. x%+=indentation/72000*180
  924. dy%=addrsize/72*180
  925. y%-=dy%*1.2
  926.  loop%=1 
  927.  last%(label%)
  928.  loop%=last%(label%) 
  929.  "Font_FindFont",,font$(3),addrsize*16,addrsize*16 
  930.  font%(3,1)
  931.   font%=font%(3,1)
  932.  "Font_FindFont",,font$(2),addrsize*16,addrsize*16 
  933.  font%(2,1)
  934.   font%=font%(2,1)
  935.  "Font_SetFont",font%
  936.  "ColourTrans_SetFontColours",,-256,0,14
  937.  "Font_Paint",,addr$(label%,loop%),1<<4,x%,y%
  938.  "Font_LoseFont",font%
  939.  loop%=last%(label%) 
  940.   font%(3,1)=0
  941.    font%(2,1)=0
  942.  x%+=indentation/72000*180
  943.  y%-=dy%
  944. fixed16(N)=N*(2^16)
  945. intersect(boxA%,boxB%)
  946.  boxA%!0<=boxB%!0 
  947.  boxA%!8>=boxB%!0 
  948.  boxA%!0<boxB%!8 
  949.  boxA%!8>=boxB%!12 
  950.  boxA%!4<=boxB%!4 
  951.  boxA%!12>=boxB%!4 
  952.  boxA%!4<boxB%!12 
  953.  boxA%!12>=boxB%!12 
  954. - Business part ENDS
  955. no_acknowledge
  956.  block%!16 
  957. apptrans%=
  958.  i%=0 
  959. block%!i%=block%!(i%+512)
  960.  "Wimp_SendMessage",18,block%,block%!4
  961. apptrans%=
  962.  &400C6:
  963. inputfile$="RAM Transfer"
  964. icontextaddr(window%(mainW%,1),2)=inputfile$
  965. centre(window%(mainW%,1),2)
  966. RAMTransmit
  967. filesize%+=block%!24
  968.  block%!24=RAMb% 
  969. extend_named_sliding_block(fileanchor%,filesize%+RAMb%)
  970. block%!12=my_ref%
  971. block%!16=6
  972. $block%!20=!fileanchor%+filesize%
  973. block%!24=RAMb%
  974.  "Wimp_SendMessage",17,block%,fromtask%
  975. block%!0=24
  976. block%!12=0
  977. block%!16=&400C6
  978. block%!20=fromtask%
  979.  "Wimp_SendMessage",18,block%
  980. checknewfile(filesize%)
  981. checknewfile(fsize%)
  982. extend_named_sliding_block(fileanchor%,fsize%+1)
  983. file%=!fileanchor%
  984. file%?fsize%=10
  985.  file%?(fsize%-1)<>10 
  986.  fsize%+=1:
  987. checknewfile(fsize%)
  988. CSVlength%=fsize%
  989. pdriver
  990. pdriver%=
  991.  xres%,yres%,xres$,yres$
  992. :pdriver$="none installed":pres$="none installed":
  993.  "PDriver_Info" 
  994.  ,xres%,yres%,,pdriver$
  995. xres$=
  996.  xres%
  997. yres$=
  998.  yres%
  999.  xres$>
  1000.  yres$
  1001. yres$+=" "
  1002.  xres$<
  1003.  yres$
  1004. xres$=" "+xres$
  1005. pres$=xres$+" 
  1006.  "+yres$
  1007. pdriver%=
  1008. lighticon(wi%,ic%,co%)
  1009. q%=block%+&100
  1010. q%!0=wi%
  1011. q%!4=ic%
  1012.  co% 
  1013. q%!8=0
  1014. q%!8=1<<22
  1015. q%!12=1<<22
  1016.  "Wimp_SetIconState",,q%
  1017. keypress(w%,i%,s%,k%)
  1018.  index%,process%
  1019. process%=
  1020. index%=
  1021. index(w%,
  1022.  index% 
  1023.  mainW%: 
  1024. main_key(w%,i%,k%)
  1025.  process% 
  1026.  "Wimp_ProcessKey",k%
  1027. main_key(w%,i%,k%)
  1028.  k%<>13 
  1029.  17,18:
  1030.  s$,s
  1031.   s$=$
  1032. icontextaddr(w%,i%)
  1033. s$,2)="pt" 
  1034.  s>(height/1000) 
  1035.   @%="+g10.3"
  1036.  i%=17 
  1037. icontextaddr(w%,i%)=
  1038.  namesize+"pt" 
  1039. icontextaddr(w%,i%)=
  1040.  addrsize+"pt"
  1041.  "Wimp_SetCaretPosition",-1
  1042. wimpy_error(0,"That value is ridiculous! The label itself isn't that high!",
  1043.  i%=17 
  1044.  namesize=s 
  1045.  addrsize=s
  1046. icontextaddr(w%,i%)=
  1047.  s+"pt"
  1048. redrawicon(w%,i%)
  1049. main_click(0,0,4,mainW%,9)
  1050.  simulate click on default icon
  1051. process%=
  1052. centre(w%,i%)
  1053. q%=block%+&100
  1054. q%!0=w%
  1055. q%!4=i%
  1056. q%!8=(1<<3)
  1057. q%!12=(1<<3)+(1<<9)
  1058.  "Wimp_SetIconState",,q%
  1059. rj(w%,i%)
  1060. q%=block%+&100
  1061. q%!0=w%
  1062. q%!4=i%
  1063. q%!8=(1<<9)
  1064. q%!12=(1<<3)+(1<<9)
  1065.  "Wimp_SetIconState",,q%
  1066. mptomm(mp)
  1067. mmtomp=(1/25.40005)*72000
  1068. =mp/mmtomp
  1069. mmtomp(mm)
  1070. mmtomp=(1/25.40005)*72000
  1071. =mm*mmtomp
  1072. strtomp(str$)
  1073.  srcunits$,number$
  1074. srcunits$=
  1075. str$,2)
  1076. number$=
  1077. str$))
  1078.  srcunits$ 
  1079.  "mp":=
  1080.  number$
  1081.  "pt":=
  1082.  number$*1000
  1083.  "in":=
  1084.  number$*72000
  1085.  "mm":=
  1086. mmtomp(
  1087.  number$)
  1088.  "cm":=
  1089. mmtomp(
  1090.  number$)*10
  1091. strtomp(
  1092.  str$)+units$)
  1093. display(mp)
  1094.  str$,oldf%
  1095. oldf%=@%
  1096.  units$ 
  1097.  "in":@%="+g10.3":str$=
  1098. (mp/72000)+"in"
  1099.  "pt":@%="+g10.9":str$=
  1100. (mp/1000)+"pt"
  1101.  "mp":@%="+g10.9":str$=
  1102.  mp+"mp"
  1103.  "mm":@%="+g10.3":str$=
  1104. mptomm(mp))+"mm"
  1105.  "cm":@%="+g10.3":str$=
  1106. mptomm(mp)/10)+"cm"
  1107. @%=oldf%
  1108. B    =str$
  1109. ask_if_print
  1110. pdriver
  1111.  pdriver%=
  1112. confirm("Print this CSV file on "+pdriver$+" printer at "+pres$+"?")=
  1113. print
  1114. confirm(str$)
  1115. !block%=0
  1116. $(block%+4)=str$+
  1117.  "Wimp_ReportError",block%,&13,"!PrintLbls, confirm:" 
  1118.  ,result%
  1119. =result%=1
  1120.  --- SLIDING HEAP 2.00 PROCEDURES
  1121.  requires SlidingHeap 2.00
  1122.  module and PROCs
  1123.  Steven Haslam 1992
  1124. _heap_slotsize
  1125.  "Wimp_SlotSize",-1,-1 
  1126. _heap_numtostr(d%,n%)=
  1127. d%,"0")+
  1128. ~n%,d%)
  1129. _heap_snumtostr(d%,n%)=
  1130. d%," ")+
  1131.  n%,d%)
  1132. heapsinfo
  1133.  "OS_Heap",1,fixedheapbase% 
  1134.  ,,bigbloc%,totfree%
  1135.  "Fixed heap"
  1136.  "----- ----"
  1137.  "Heap base    : &";
  1138. _heap_numtostr(8,fixedheapbase%)
  1139.  "Heap size    : ";
  1140. _heap_bytes2(fixedheapsize%)
  1141.  "Largest free : ";
  1142. _heap_bytes2(bigbloc%)
  1143.  "Total free   : ";
  1144. _heap_bytes2(totfree%)
  1145.  "Sliding heap"
  1146.  "------- ----"
  1147.  "SlidingHeap_HeapInfo",slidingheapbase%
  1148. _heap_pageup(n%)
  1149.  "OS_ReadMemMapInfo" 
  1150. =(n%+R0%-1) 
  1151.  (R0%-1)
  1152. initheaps(heapsize%,slidingblocks%)
  1153. fixedheapsize%=heapsize%
  1154. uLheap_trigger%=
  1155. _heap_pageup(
  1156. +fixedheapsize%+20+20*slidingblocks%-&8000)
  1157. setslotsize(heap_trigger%)
  1158. _heap_slotsize<heap_trigger% 
  1159.  130,"Unable to initialise heap"
  1160. fixedheapbase%=
  1161. y%slidingheapbase%=
  1162. +fixedheapsize%
  1163.  "OS_Heap",0,fixedheapbase%,,fixedheapsize%
  1164.  "SlidingHeap_Create",slidingheapbase%,2,slidingblocks%
  1165.  "SlidingHeap_VerifyHeap",slidingheapbase%
  1166. _heap_nextfree
  1167.  nextfree%
  1168.  "SlidingHeap_NextFree",slidingheapbase% 
  1169.  nextfree%
  1170. =nextfree%
  1171. destroyheaps
  1172. setslotsize(
  1173. -&8000)
  1174. _heap_wordup(x%)=(x%+3) 
  1175. create_anchor(name$)
  1176.  space%
  1177.  space% 4+
  1178.  name$+1
  1179. !space%=0
  1180. $(space%+4)=name$
  1181. =space%
  1182. create_named_sliding_block(anchor%,size%)
  1183.  trysize%
  1184. size%=
  1185. _heap_wordup(size%)
  1186. 7trysize%=
  1187. _heap_pageup(
  1188. _heap_nextfree+size%-&7FF4)
  1189.  trysize%>heap_trigger% 
  1190. setslotsize(trysize%)
  1191. _heap_slotsize<trysize% 
  1192. %      
  1193. setslotsize(heap_trigger%)
  1194. F      
  1195.  131,"Not enough room to create block """+$(anchor%+4)+""""
  1196.        heap_trigger%=trysize%
  1197.  "SlidingHeap_NewBlock",slidingheapbase%,anchor%,size%,anchor%+4
  1198.  "SlidingHeap_VerifyHeap",slidingheapbase%
  1199. scrap_sliding_block(anchor%)
  1200.  !anchor%=0 
  1201.  "SlidingHeap_ScrapBlock",slidingheapbase%,anchor%
  1202. 1trysize%=
  1203. _heap_pageup(
  1204. _heap_nextfree-&7FFC)
  1205.  trysize%<>heap_trigger% 
  1206. setslotsize(trysize%)
  1207.    heap_trigger%=trysize%
  1208. !anchor%=0
  1209.  "SlidingHeap_VerifyHeap",slidingheapbase%
  1210. setslotsize(newsize%)
  1211.  "Wimp_SlotSize",newsize%,-1
  1212. extend_named_sliding_block(anchor%,newsize%)
  1213.  !anchor%=0 
  1214. create_named_sliding_block(anchor%,newsize%):
  1215.  !anchor%>
  1216. _heap_nextfree 
  1217.  129,"Block beyond heap limits"
  1218. $newsize%=
  1219. _heap_wordup(newsize%)
  1220.  "SlidingHeap_DescribeBlock",slidingheapbase%,anchor% 
  1221.  ,,oldsize%
  1222. larger%=newsize%>oldsize%
  1223.  larger% 
  1224. H   trysize%=
  1225. _heap_pageup(
  1226. _heap_nextfree+(newsize%-oldsize%)-&7FFC)
  1227.  trysize%>heap_trigger% 
  1228.        
  1229. setslotsize(trysize%)
  1230. &      
  1231. _heap_slotsize<trysize% 
  1232. (         
  1233. setslotsize(heap_trigger%)
  1234. @         
  1235.  132,"Not enough room to extend block #"+
  1236. ~anchor%
  1237.       
  1238. #         heap_trigger%=trysize%
  1239.       
  1240.  "SlidingHeap_ExtendBlock",slidingheapbase%,anchor%,newsize%
  1241. 1trysize%=
  1242. _heap_pageup(
  1243. _heap_nextfree-&7FFC)
  1244.  trysize%<>heap_trigger% 
  1245. setslotsize(trysize%)
  1246.    heap_trigger%=trysize%
  1247.  "SlidingHeap_VerifyHeap",slidingheapbase%
  1248. _heap_bytes(b%)
  1249.  end%
  1250.  "OS_ConvertFixedFileSize",b%,block%,block%+&100 
  1251.  ,end%
  1252. ?end%=13
  1253. =$block%
  1254. _heap_bytes2(b%)
  1255.  end%
  1256.  "OS_ConvertFileSize",b%,block%,block%+&100 
  1257.  ,end%
  1258. ?end%=13
  1259. =$block%
  1260. create_fixed_block(size%)
  1261.  pointer%,flag%
  1262.  "XOS_Heap",2,fixedheapbase%,,size% 
  1263.  ,,pointer%;flag%
  1264.  flag% 
  1265. extendfixedheap
  1266.  "XOS_Heap",2,fixedheapbase%,,size% 
  1267.  ,,pointer%;flag%
  1268. =pointer%
  1269. extendfixedheap
  1270.  nshb%,extend%,trysize%
  1271.  "OS_ReadMemMapInfo" 
  1272.  extend%
  1273. $trysize%=
  1274. _heap_slotsize+extend%
  1275. setslotsize(trysize%)
  1276. _heap_slotsize<trysize% 
  1277.  255,"No room to extend fixed heap"
  1278. "nshb%=slidingheapbase%+extend%
  1279.  "SlidingHeap_ShiftHeap",slidingheapbase%,nshb%
  1280.  "OS_Heap",5,fixedheapbase%,,extend%
  1281. fixedheapsize%+=extend%
  1282. slidingheapbase%=nshb%
  1283.  "SlidingHeap_VerifyHeap",slidingheapbase%
  1284.  ------------Harriet's extra procedures--------------------------------------
  1285. FontMenu(tickme$)
  1286.  menubuf%,indirbuf%,f%
  1287. $(block%+&100)=tickme$
  1288. "Hourglass_On"
  1289. "Font_ListFonts",,0,&C0000,-1,0 
  1290.  ,,,menubuf%,,indirbuf%
  1291.  find block size required
  1292. extend_named_sliding_block(fontmenu%,menubuf%)
  1293. extend_named_sliding_block(indir%,indirbuf%)
  1294. "Font_ListFonts",,!fontmenu%,%101100<<16,menubuf%,!indir%,indirbuf%,block%+&100
  1295. "Hourglass_Off"
  1296. fontM%=!fontmenu%
  1297. highfontM%!32=fontM%
  1298. highfontM%!56=fontM%
  1299. highfontM%!80=fontM%
  1300.  in case menu structure has moved in memory
  1301. checkfontsOK
  1302. lose_fonts
  1303.  f%=1 
  1304. ifthere("Font:"+font$(f%))=0 
  1305.  check for existence of directory on Font$Path
  1306. wimpy_error(0,"Font "+
  1307. (34)+font$(f%)+
  1308. (34)+" not found. It shall be replaced by ""Trinity.Medium""",
  1309.    font$(f%)="Trinity.Medium"
  1310.   font%(f%,0)=0
  1311.  window%(mainW%,1)>0 
  1312.  f%=1 
  1313. get_font(f%)
  1314. update_fontcontrols
  1315. ifthere(path$):
  1316.  won't warn you of *open* files, only non-existent ones
  1317. "OS_File",17,path$ 
  1318. decodefontmenu(menustring$)
  1319.  translate menu data into sensible font name
  1320.  fontstart%
  1321. #fontstart%=
  1322. menustring$,"\f1 ")
  1323.  fontstart% 
  1324. *menustring$=
  1325. menustring$,fontstart%+4)
  1326. !#fontstart%=
  1327. menustring$,"\F")+2
  1328. "Pmenustring$=
  1329. menustring$,fontstart%,
  1330. menustring$,"\",fontstart%)-fontstart%)
  1331. =menustring$
  1332.